home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue59 / RichEdit / DCRichEditReg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-04-26  |  9.2 KB  |  353 lines
  1. unit DCRichEditReg;
  2.  
  3. {$ifdef Ver93} { C++ Builder 1.0x }
  4.   {$define DelphiLessThan4}
  5. {$endif}
  6. {$ifdef Ver100} { Delphi 3.0x }
  7.   {$define DelphiLessThan4}
  8. {$endif}
  9. {$ifdef Ver110} { C++ Builder 3.0x }
  10.   {$define DelphiLessThan4}
  11. {$endif}
  12.  
  13. interface
  14.  
  15. uses
  16. {$ifndef DelphiLessThan4}
  17.   ImgList,
  18. {$endif}
  19.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  20.   StdCtrls, ComCtrls, DCRichEdit, ExtCtrls, ToolWin;
  21.  
  22. type
  23.   TRTFForm = class(TForm)
  24.     RichEdit: TRichEdit;
  25.     OKButton: TButton;
  26.     CancelButton: TButton;
  27.     OpenDialog: TOpenDialog;
  28.     Timer: TTimer;
  29.     StandardToolBar: TToolBar;
  30.     ClearButton1: TToolButton;
  31.     OpenButton: TToolButton;
  32.     ToolButton5: TToolButton;
  33.     CutButton: TToolButton;
  34.     CopyButton: TToolButton;
  35.     PasteButton: TToolButton;
  36.     UndoButton: TToolButton;
  37.     ToolButton10: TToolButton;
  38.     FontName: TComboBox;
  39.     ToolButton11: TToolButton;
  40.     FontSize: TEdit;
  41.     UpDown1: TUpDown;
  42.     ToolButton2: TToolButton;
  43.     BoldButton: TToolButton;
  44.     ItalicButton: TToolButton;
  45.     UnderlineButton: TToolButton;
  46.     ToolButton16: TToolButton;
  47.     LeftAlign: TToolButton;
  48.     CenterAlign: TToolButton;
  49.     RightAlign: TToolButton;
  50.     ToolButton20: TToolButton;
  51.     BulletsButton: TToolButton;
  52.     ToolbarImages: TImageList;
  53.     ToolButton1: TToolButton;
  54.     ColorButton: TToolButton;
  55.     ColorDialog: TColorDialog;
  56.     procedure FormCreate(Sender: TObject);
  57.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  58.       Shift: TShiftState);
  59.     procedure RichEditSelectionChange(Sender: TObject);
  60.     procedure ClearButton1Click(Sender: TObject);
  61.     procedure OpenButtonClick(Sender: TObject);
  62.     procedure CutButtonClick(Sender: TObject);
  63.     procedure CopyButtonClick(Sender: TObject);
  64.     procedure PasteButtonClick(Sender: TObject);
  65.     procedure UndoButtonClick(Sender: TObject);
  66.     procedure FontNameChange(Sender: TObject);
  67.     procedure FontSizeChange(Sender: TObject);
  68.     procedure BoldButtonClick(Sender: TObject);
  69.     procedure ItalicButtonClick(Sender: TObject);
  70.     procedure UnderlineButtonClick(Sender: TObject);
  71.     procedure AlignClick(Sender: TObject);
  72.     procedure BulletsButtonClick(Sender: TObject);
  73.     procedure TimerTick(Sender: TObject);
  74.     procedure ColorButtonClick(Sender: TObject);
  75.   private
  76.     FUpdating: Boolean;
  77.     procedure GetFontNames;
  78.     function CurrText: TTextAttributes;
  79.   end;
  80.  
  81. procedure Register;
  82.  
  83. implementation
  84.  
  85. {$R *.DFM}
  86.  
  87. uses
  88.   DsgnIntf, ClipBrd, ActiveX;
  89.  
  90. //Property editor
  91. type
  92.   TLinesProperty = class(TClassProperty)
  93.   public
  94.     procedure Edit; override;
  95.     function GetAttributes: TPropertyAttributes; override;
  96.   end;
  97.  
  98. { TLinesProperty }
  99.  
  100. procedure TLinesProperty.Edit;
  101. var
  102.   Loop: Integer;
  103.   NewRTF: String;
  104. begin
  105.   with TRTFForm.Create(Application) do
  106.     try
  107.       StringToRichEditLines(
  108.         RichEditLinesToString(GetComponent(0) as TCustomRichEdit), RichEdit);
  109.       //Display RTF editing form
  110.       if ShowModal = mrOk then
  111.       begin
  112.         //If user presses OK, give new property value to selected components
  113.         NewRTF := RichEditLinesToString(RichEdit);
  114.         for Loop := 0 to PropCount - 1 do
  115.           StringToRichEditLines(NewRTF, GetComponent(Loop) as TCustomRichEdit);
  116.         //Make sure form designer spots the property change
  117.         Self.Designer.Modified
  118.       end
  119.     finally
  120.       Free
  121.     end
  122. end;
  123.  
  124. function TLinesProperty.GetAttributes: TPropertyAttributes;
  125. begin
  126.   //Request the ellipsis button, and remove the expandable property capability
  127.   Result := inherited GetAttributes + [paDialog] - [paSubProperties]
  128. end;
  129.  
  130. //Component editor
  131. type
  132.   TDCRichEditEditor = class(TComponentEditor)
  133.   public
  134.     procedure ExecuteVerb(Index: Integer); override;
  135.     function GetVerb(Index: Integer): string; override;
  136.     function GetVerbCount: Integer; override;
  137.   end;
  138.  
  139. { TDCRichEditEditor }
  140.  
  141. procedure TDCRichEditEditor.ExecuteVerb(Index: Integer);
  142. begin
  143.   if Index = 0 then
  144.     with TRTFForm.Create(Application) do
  145.       try
  146.         StringToRichEditLines(
  147.           RichEditLinesToString(Component as TDCRichEdit), RichEdit);
  148.         //Display RTF loading form and proceed if OK is pressed
  149.         if ShowModal = mrOk then
  150.         begin
  151.           StringToRichEditLines(
  152.             RichEditLinesToString(RichEdit), Component as TDCRichEdit);
  153.           //Make sure form designer spots the property change
  154.           Self.Designer.Modified
  155.         end
  156.       finally
  157.         Free
  158.       end
  159. end;
  160.  
  161. function TDCRichEditEditor.GetVerb(Index: Integer): string;
  162. begin
  163.   if Index = 0 then
  164.     Result := 'Edit formatted text...'
  165. end;
  166.  
  167. function TDCRichEditEditor.GetVerbCount: Integer;
  168. begin
  169.   Result := 1
  170. end;
  171.  
  172. procedure Register;
  173. begin
  174.   RegisterComponents('Clinic', [TDCRichEdit]);
  175.   RegisterPropertyEditor(TypeInfo(TStrings), TDCRichEdit,
  176.     'Lines', TLinesProperty);
  177.   RegisterComponentEditor(TDCRichEdit, TDCRichEditEditor)
  178. end;
  179.  
  180. { TRTFForm } //The RTF editing form
  181.  
  182. function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  183.   FontType: Integer; Data: Pointer): Integer; stdcall;
  184. begin
  185.   TStrings(Data).Add(LogFont.lfFaceName);
  186.   Result := 1;
  187. end;
  188.  
  189. procedure TRTFForm.GetFontNames;
  190. var
  191.   DC: HDC;
  192. begin
  193.   DC := GetDC(0);
  194.   try
  195.     EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items))
  196.   finally
  197.     ReleaseDC(0, DC)
  198.   end;
  199.   FontName.Sorted := True;
  200. end;
  201.  
  202. function TRTFForm.CurrText: TTextAttributes;
  203. begin
  204.   if RichEdit.SelLength > 0 then
  205.     Result := RichEdit.SelAttributes
  206.   else
  207.     Result := RichEdit.DefAttributes;
  208. end;
  209.  
  210. procedure TRTFForm.FormCreate(Sender: TObject);
  211. begin
  212.   GetFontNames;
  213.   RichEditSelectionChange(RichEdit);
  214. end;
  215.  
  216. procedure TRTFForm.FormKeyDown(Sender: TObject; var Key: Word;
  217.   Shift: TShiftState);
  218. begin
  219.   if Key = vk_Escape then
  220.     CancelButton.Click
  221. end;
  222.  
  223. var
  224.   CF_RTF: TClipFormat;
  225.  
  226. procedure TRTFForm.RichEditSelectionChange(Sender: TObject);
  227. begin
  228.   with RichEdit.Paragraph do
  229.   try
  230.     FUpdating := True;
  231.     CutButton.Enabled := RichEdit.SelLength > 0;
  232.     CopyButton.Enabled := CutButton.Enabled;
  233.     BoldButton.Down := fsBold in RichEdit.SelAttributes.Style;
  234.     ItalicButton.Down := fsItalic in RichEdit.SelAttributes.Style;
  235.     UnderlineButton.Down := fsUnderline in RichEdit.SelAttributes.Style;
  236.     BulletsButton.Down := Boolean(Numbering);
  237.     FontSize.Text := IntToStr(RichEdit.SelAttributes.Size);
  238.     FontName.Text := RichEdit.SelAttributes.Name;
  239.     case Ord(Alignment) of
  240.       0: LeftAlign.Down := True;
  241.       1: RightAlign.Down := True;
  242.       2: CenterAlign.Down := True;
  243.     end;
  244.   finally
  245.     FUpdating := False;
  246.   end;
  247. end;
  248.  
  249. procedure TRTFForm.ClearButton1Click(Sender: TObject);
  250. begin
  251.   RichEdit.Lines.Clear
  252. end;
  253.  
  254. procedure TRTFForm.OpenButtonClick(Sender: TObject);
  255. begin
  256.   if OpenDialog.Execute then
  257.     RichEdit.Lines.LoadFromFile(OpenDialog.FileName);
  258. end;
  259.  
  260. procedure TRTFForm.CutButtonClick(Sender: TObject);
  261. begin
  262.   RichEdit.CutToClipboard
  263. end;
  264.  
  265. procedure TRTFForm.CopyButtonClick(Sender: TObject);
  266. begin
  267.   RichEdit.CopyToClipboard
  268. end;
  269.  
  270. procedure TRTFForm.PasteButtonClick(Sender: TObject);
  271. begin
  272.   RichEdit.PasteFromClipboard
  273. end;
  274.  
  275. procedure TRTFForm.UndoButtonClick(Sender: TObject);
  276. begin
  277.   //Delphi 4 introduces an Undo method to replace this
  278.   RichEdit.Perform(WM_UNDO, 0, 0)
  279. end;
  280.  
  281. procedure TRTFForm.FontNameChange(Sender: TObject);
  282. begin
  283.   if not FUpdating then
  284.     CurrText.Name := FontName.Items[FontName.ItemIndex];
  285. end;
  286.  
  287. procedure TRTFForm.FontSizeChange(Sender: TObject);
  288. begin
  289.   if not FUpdating then
  290.     CurrText.Size := StrToInt(FontSize.Text);
  291. end;
  292.  
  293. procedure TRTFForm.BoldButtonClick(Sender: TObject);
  294. begin
  295.   if not FUpdating then
  296.     if BoldButton.Down then
  297.       CurrText.Style := CurrText.Style + [fsBold]
  298.     else
  299.       CurrText.Style := CurrText.Style - [fsBold];
  300. end;
  301.  
  302. procedure TRTFForm.ItalicButtonClick(Sender: TObject);
  303. begin
  304.   if not FUpdating then
  305.     if ItalicButton.Down then
  306.       CurrText.Style := CurrText.Style + [fsItalic]
  307.     else
  308.       CurrText.Style := CurrText.Style - [fsItalic];
  309. end;
  310.  
  311. procedure TRTFForm.UnderlineButtonClick(Sender: TObject);
  312. begin
  313.   if not FUpdating then
  314.     if UnderlineButton.Down then
  315.       CurrText.Style := CurrText.Style + [fsUnderline]
  316.     else
  317.       CurrText.Style := CurrText.Style - [fsUnderline];
  318. end;
  319.  
  320. procedure TRTFForm.AlignClick(Sender: TObject);
  321. begin
  322.   if not FUpdating then
  323.     RichEdit.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
  324. end;
  325.  
  326. procedure TRTFForm.BulletsButtonClick(Sender: TObject);
  327. begin
  328.   if not FUpdating then
  329.     RichEdit.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
  330. end;
  331.  
  332. procedure TRTFForm.TimerTick(Sender: TObject);
  333. begin
  334.   PasteButton.Enabled :=
  335.     ClipBoard.HasFormat(CF_TEXT) or
  336.     ClipBoard.HasFormat(CF_OEMTEXT) or
  337.     ClipBoard.HasFormat(CF_UNICODETEXT) or
  338.     ClipBoard.HasFormat(CF_RTF);
  339. end;
  340.  
  341. procedure TRTFForm.ColorButtonClick(Sender: TObject);
  342. begin
  343.   if FUpdating then
  344.     Exit; 
  345.   ColorDialog.Color := CurrText.Color;
  346.   if ColorDialog.Execute then
  347.     CurrText.Color := ColorDialog.Color
  348. end;
  349.  
  350. initialization
  351.   CF_RTF := RegisterClipboardFormat('Rich Text Format');
  352. end.
  353.